home *** CD-ROM | disk | FTP | other *** search
/ BMUG Revelations / BMUG Revelations.toast / Programming / Programming Languages / Yerk 3.64 / Supplement / Unsupported / Optionals / SQwave < prev    next >
Text File  |  1986-02-08  |  4KB  |  141 lines
  1. \ Square Wave sound generation class
  2. \ written 7/3/85 by John Papiewski
  3. \ v 1.1 7/6/85 added Octave array, Fixed first-note bug
  4. \ added no-wait code July 11, 1985
  5.  
  6. \ musr first load: Struct1
  7.  
  8. :Class SQWave <Super Warray
  9.  
  10.    12 bytes name       \ driver name
  11.     12 bytes header     \ fields for internal use
  12.     Var   IOComp        \ i/o completion ptr
  13.     Int   IOResult      \ return code
  14.     Var   IONamePtr     \ name of drvr
  15.     Int   vref
  16.     Int   IORefNum
  17.     Int   csCode       \ 26
  18.     Int  csP1           \ 28
  19.     Int  csP2           \ 30
  20.     Var   IOBuffer
  21.     Var   IOReq
  22.     Var   IOAct
  23.     6 bytes  junk2      \ posMode, offset - block devices only
  24.     var Proc
  25. 24 Warray Octave   \ This array can be used by your program to make music.
  26.                    \ the 0th element is C below Mid-C, 1st is D-flat, etc.
  27.                    \ This array gets initialized by Setnotes method (see below)
  28.     
  29. 35 3 * Warray Tones \ this array holds the notes to be played. The number of
  30.                     \ elements needed = (notes + 2) x 3, so just change the
  31.                     \ "35" to some other value for your program.
  32. \ Pitch of note (hz) = 783360/count
  33. \ loudness of note = 0-255
  34. \ duration of note = 0-255 ticks @ 60/second
  35. :M SQclear: 
  36.     clear: Tones
  37. ;M
  38. :M SetCnt: { Cnt Cindex -- }
  39.     Cnt Cindex 3 * 1 + to: Tones
  40. ;M
  41. :M Setloud: { Loud Lindex -- }
  42.     Loud Lindex 3 * 2 + To: Tones
  43. ;M
  44. :M SetSDur: { Dur Dindex -- }
  45.     Dur Dindex 3 * 3 + To: Tones
  46. ;M
  47. :M SetNotes:
  48.     5935 0 To: Octave 5564 1 To: Octave 5275 2 To: Octave 4945 3 To: Octave 
  49.     4748 4 To: Octave 4451 5 To: Octave 4172 6 To: Octave 3956 7 To: Octave 
  50.     3709 8 To: Octave 3561 9 To: Octave 3391 10 To: Octave 3165 11 To: Octave 
  51.     2967 12 To: Octave 2782 13 To: Octave 2638 14 To: Octave 2473 15 To: Octave
  52.     2374 16 To: Octave 2225 17 To: Octave 2086 18 To: Octave 1978 19 To: Octave
  53.     1855 20 To: Octave 1780 21 To: Octave 1696 22 To: Octave 1583 23 To: Octave
  54. ;M
  55. :M PutNote: { Tone Dest -- }
  56.     Tone At: Octave Dest SetCnt: Self
  57. ;M
  58.  
  59. \ ( addr len -- ) name the driver 
  60. :M NAME:  ^base 50 erase  addr: name >str255  
  61.        put: ioNamePtr   ;M
  62.  
  63. :M OPEN:  addr: header 0 (open)   ;M
  64.  
  65. :M CLOSE:  addr: header (close)   ;M
  66.  
  67. \  ( addr len -- )  read n bytes via the driver
  68. :M READ:  { addr len -- fcode }  addr: header len addr (read)  ;M
  69.  
  70. \ no-wait read requires a completion PROC
  71. :M READNW:  { theWord  addr len -- fcode }
  72.       addr +base put: IOBuffer  theWord +base put: IOComp
  73.       len put: IOReq addr: header $ a402 (fdos)   ;M
  74.  
  75. \ no-wait write requires a completion PROC
  76. :M WRITENW:  { theWord  addr len -- fcode }
  77.       addr +base put: IOBuffer  theWord +base put: IOComp
  78.       len put: IOReq  addr: header $ a403 (fdos)   ;M
  79.  
  80. \ write n bytes via the driver 
  81. :M WRITE:  { addr len -- fcode }  addr: header len addr (write)  ;M
  82.  
  83. \ return actual count of bytes read 
  84. :M BYTESREAD:  get: IOAct   ;M
  85.  
  86. \ leave the current IOResult value  
  87. :M RESULT:   get: IOResult  ;M
  88.  
  89. :M Dosq: { Notes -- }
  90.     -4 put: IORefnum put: IOComp 2 Notes 1 + 6 * + put: IOreq
  91.     Abs: Tones 4 +  Put: IOBuffer
  92.     " .Sound" name: SELF open: Self
  93.     -1 0 To: Tones ixaddr: Tones 
  94.    2 Notes 2 + 6 * + write: Self
  95.     drop
  96. ;M
  97. :M NWDosq: { Notes Proc -- }         \ No-wait (asynchronous) version
  98.     -4 put: IORefnum put: IOComp 2 Notes 1 + 6 * + put: IOreq
  99.     Abs: Tones 4 +  Put: IOBuffer
  100.     " .Sound" name: SELF open: Self
  101.     -1 0 To: Tones 
  102.     Proc ixaddr: Tones 2 Notes 2 + 6 * + writeNW: Self
  103.     drop
  104. ;M
  105. ;Class
  106.  
  107. \ Here's the example:
  108. \ The following Procedure executes on an interrupt from the Mac
  109. \ When I/O is done, when you use the no-wait write.
  110. \ You can put other stuff in the proc definition to suit your application
  111.  
  112. 0 value DoneSwitch
  113.  
  114. :Proc Done 1 -> DoneSwitch   ;Proc    
  115.  
  116. cr cr
  117. ." Square Wave Demonstration"
  118. 1 SqWave Tune   
  119. SetNotes: Tune
  120. SQclear: Tune
  121. : PlayTune
  122. 12 0 Do
  123.     i dup PutNote: Tune
  124.     128 i SetLoud: Tune 26 i SetSdur: Tune
  125. Loop
  126. ;
  127. Playtune
  128. 12 ' Done NWDosq: Tune
  129. cr
  130. ." Waiting for finish"
  131.  
  132. : Waitdone
  133. Begin DoneSwitch Until
  134. ;
  135. Waitdone
  136. SQclear: Tune
  137. 1000 0 Setcnt: Tune
  138. 128 0 SetLoud: Tune
  139. 120 0 SetSdur: Tune
  140. 1 ' Done  NWDosq: Tune
  141.